home *** CD-ROM | disk | FTP | other *** search
- /* pnmindex - build a visual index of a bunch of anymaps
- *
- * Copyright (C) 1994 by Ingo Wilken (Ingo.Wilken@informatik.uni-oldenburg.de)
- * Based on the pnmindex csh-script by Jef Poskanzer
- *
- * Permission to use, copy, modify, and distribute this software and its
- * documentation for any purpose and without fee is hereby granted, provided
- * that the above copyright notice appear in all copies and that both that
- * copyright notice and this permission notice appear in supporting
- * documentation. This software is provided "as is" without express or
- * implied warranty.
- *
- * $VER: pnmindex 1.0
- */
- parse source junk junk progname junk
-
- address command
- signal on error
- signal on break_c
- signal on break_d
- signal on ioerr
- signal on halt
- ID = pragma('Id')
-
- call open(err, "CONSOLE:", 'W')
- if ~result then exit 20
-
- if ~show('L', 'rexxsupport.library') then do
- if ~addlib('rexxsupport.library', 0, -30, 0) then exit 20
- end
- if ~showlist('A', 'PBMTMP') then 'assign PBMTMP: T:'
-
- size = 100 /* make the images about this big */
- across = 6 /* show this many images per row */
- colors = 256 /* quantize results to this many colors */
- back = '-white' /* default background color */
- fastquant = 0 /* -qfast: use ppmqvga instead of ppmquant */
- quantall = 1 /* -qonce: quantize only final result instead of every picture */
- addsizes = 0 /* -printsizes: add size info below name */
- font = '' /* -font option and fontfile */
- baseopt = 0 /* -nopath: print basenames of pictures instead of whole path */
- filter = '' /* run the files through this filter first */
-
- if arg() = 0 then call usage
-
- parse arg tail
- do forever
- parse var tail first tail
- select
- when abbrev('-size', first, 2) then do
- parse var tail size tail
- if ~datatype(size, 'W') then call usage
- if size < 1 then call usage
- end
- when abbrev('-across', first, 2) then do
- parse var tail across tail
- if ~datatype(across, 'W') then call usage
- if across < 1 then call usage
- end
- when abbrev('-colors', first, 2) then do
- parse var tail colors tail
- if ~datatype(colors, 'W') then call usage
- if colors < 2 then call usage
- end
- when abbrev('-black', first, 2) then do
- back = '-black'
- end
- when abbrev('-qfast', first, 3) then do
- fastquant = 1
- colors = 256
- end
- when abbrev('-qonce', first, 3) then do
- quantall = 0
- end
- when abbrev('-printsizes', first, 2) then do
- addsizes = 1
- end
- when abbrev('-nopath', first, 2) then do
- baseopt = 1
- end
- when abbrev('-filter', first, 3) then do
- parse var tail filter tail
- end
- when abbrev('-font', first, 3) then do
- parse var tail first tail
- if ~exists(first) then do
- call writeln(err, 'fontfile' first 'does not exist')
- call finish 20
- end
- font = '-font' first
- end
- when abbrev(first, '-', 1) then call usage
- otherwise leave
- end
- end
-
- tmpfile = 'PBMTMP:pi.tmp.'ID
- tmpfile2= 'PBMTMP:pi.tmp2.'ID
- tmppip1 = 'PBMTMP:pi.pip1.'ID
- tmppip2 = 'PBMTMP:pi.pip2.'ID
- tmppip3 = 'PBMTMP:pi.pip3.'ID
- call rm tmpfile tmpfile2 tmppip1 tmppip2 tmppip3
- rowfiles = ''
- imagefiles = ''
- maxformat = 'PBM'
- col = 1
- row = 1
-
- /* Expand filenames */
- files = ''
- do while first ~= ''
- 'list lformat "%s%s"' first 'to' tmppip1
- 'echo "" >>' tmppip1 /* avoid 0-byte file, sort would fail */
- 'sort from' tmppip1 'to' tmppip2
- call open(file, tmppip2, 'R')
- if ~result then do
- call writeln(err, 'where is my list file??')
- call finish 20
- end
- do while ~eof(file)
- line = readln(file)
- files = files line
- end
- call close(file)
- parse var tail first tail
- end
- /*call writeln(err, tail)*/
- call rm tmppip1 tmppip2
-
- parse var files first tail
- do while first ~= ''
- /*call writeln err, first*/
- /*tmpfile2 = 'PBMTMP:'basename(first)*/
- if filter ~= '' then do
- filter first '>' tmpfile2
- end
- else do
- 'copy' first tmpfile2
- end
- 'pnmfile' tmpfile2 '>' tmpfile
- call open(file, tmpfile, 'R')
- if ~result then do
- call writeln(err, 'pnmfile failed?? - aborting')
- call finish 20
- end
- line = readln(file)
- call close(file)
- /* the output format of pnmfile is "name:\tP?M <x> by <y> [...]" */
- parse var line type junk xsize junk ysize junk
- type = right(type,3)
- /*call writeln(err, type xsize ysize)*/
- if xsize <= size & ysize <= size then do
- 'copy' tmpfile2 tmpfile
- end
- else do
- select
- when type = 'PBM' then do
- 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmppip1
- 'pgmtopbm' tmppip1 '>' tmpfile
- end
- when type = 'PGM' then do
- if maxformat = 'PBM' then maxformat = 'PGM'
- 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmpfile
- end
- otherwise do
- maxformat = 'PPM'
- 'pnmscale -quiet -xysize' size size tmpfile2 '>' tmppip1
- /* 'ppmquant -quiet 'colors tmppip1 '>' tmpfile */
- if quantall then call quant tmppip1 tmpfile
- else 'copy' tmppip1 tmpfile
- end
- end /* select */
- end /* else */
- call rm tmpfile2
- imagefile = 'PBMTMP:pi.'row'.'col'.'ID
- call rm imagefile
- call open(file, tmppip2, 'W')
- if ~result then do
- call writeln(err, 'cannot open tmp file for picture text')
- call finish 20
- end
- if baseopt then
- text = basename(first)
- else
- text = first
- call writeln(file, text)
- if addsizes then call writeln(file,center(compress(xsize 'x' ysize),length(text)))
- call close(file)
- 'pbmtext' font '<' tmppip2 '>' tmppip1
- if back = '-white' then do
- 'pnmcat' back '-tb' tmpfile tmppip1 '>' imagefile
- end
- else do
- 'pnminvert' tmppip1 '>' tmppip2
- 'pnmcat' back '-tb' tmpfile tmppip2 '>' imagefile
- end
- call rm tmpfile tmppip1 tmppip2 tmppip3
- imagefiles = imagefiles imagefile
- if col >= across then do
- rowfile = 'PBMTMP:pi.'row'.'ID
- call rm rowfile
- if maxformat ~= 'PPM' then do
- 'pnmcat' back '-lr -jbottom' imagefiles '>' rowfile
- end
- else do
- 'pnmcat' back '-lr -jbottom' imagefiles '>' tmppip1
- /* 'ppmquant -quiet' colors tmppip1 '>' rowfile */
- if quantall then call quant tmppip1 rowfile
- else 'copy' tmppip1 rowfile
- call rm tmppip1
- end
- call rm imagefiles
- imagefiles = ''
- rowfiles = rowfiles rowfile
- col = 1
- row = row + 1
- end
- else do
- col = col + 1
- end
- parse var tail first tail
- end
- if words(imagefiles) > 0 then do
- /*call writeln err, imagefiles*/
- rowfile = 'PBMTMP:pi.'row'.'ID
- call rm rowfile
- if maxformat ~= 'PPM' then do
- 'pnmcat' back '-lr -jbottom' imagefiles '>' rowfile
- end
- else do
- 'pnmcat' back '-lr -jbottom' imagefiles '>' tmppip1
- /* 'ppmquant -quiet' colors tmppip1 '>' rowfile */
- if quantall then call quant tmppip1 rowfile
- else 'copy' tmppip1 rowfile
- call rm tmppip1
- end
- call rm imagefiles
- rowfiles = rowfiles rowfile
- end
- if rowfiles = '' then do
- call writeln(err, "no input files??")
- call usage
- end
- /*call writeln err, rowfiles*/
- if maxformat ~= 'PPM' then do
- 'pnmcat' back '-tb' rowfiles
- end
- else do
- 'pnmcat' back '-tb' rowfiles '>' tmppip1
- /* 'ppmquant -quiet' colors tmppip1 */
- call quant tmppip1
- call rm tmppip1
- end
- call finish 0
-
- usage:
- call writeln err, 'usage:' progname '[-size N] [-across N] [-colors N] [-black] [-filter xxxtop?m] [-printsizes] [-font fontfile] [-nopath] [-qfast] [-qonce] pnmfile ...'
- call finish 10
-
- rm: procedure
- arg name
- signal off error /* ignore WARN */
- 'delete' name 'quiet force >NIL:'
- signal on error
- return
-
- error:
- break_c:
- break_d:
- ioerr:
- halt:
- call writeln err, progname ': break/error at line' SIGL 'code' RC
- call finish 20
-
- finish:
- arg n
- call rm 'PBMTMP:pi.#?.'ID
- exit n
-
- quant: procedure expose colors fastquant
- arg infile outfile
- if outfile ~= '' then do
- if fastquant then do
- 'ppmqvga -quiet' infile '>' outfile
- end
- else do
- 'ppmquant -quiet' colors infile '>' outfile
- end
- end
- else do
- if fastquant then do
- 'ppmqvga -quiet' infile
- end
- else do
- 'ppmquant -quiet' colors infile
- end
- end
- return
-
- basename: procedure
- parse arg name
- len = length(name)
- sl = lastpos('/', name)
- if sl > 0 then return right(name, len - sl)
- sl = lastpos(':', name)
- if sl > 0 then return right(name, len - sl)
- return name
-
-